home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.004 / xemacs-1 / xemacs-19.13 / lisp / w3 / w3-sysdp.el < prev    next >
Encoding:
Text File  |  1995-08-29  |  19.8 KB  |  535 lines
  1. ;;; sysdep.el --- consolidate Emacs-version dependencies in one file.
  2.  
  3. ;; Copyright (C) 1995 Ben Wing.
  4.  
  5. ;; Author: Ben Wing <wing@netcom.com>
  6. ;; Keywords: lisp, tools
  7. ;; Version: 0.001
  8.  
  9. ;; The purpose of this file is to eliminate the cruftiness that
  10. ;; would otherwise be required of packages that want to run on multiple
  11. ;; versions of Emacs.  The idea is that we make it look like we're running
  12. ;; the latest version of XEmacs (currently 19.12) by emulating all the
  13. ;; missing functions.
  14.  
  15. ;; #### This file does not currently do any advising but should.
  16. ;; Unfortunately, advice.el is a hugely big package.  Is any such
  17. ;; thing as `advice-lite' possible?
  18.  
  19. ;; #### - This package is great, but its role needs to be thought out a bit
  20. ;; more.  Sysdep will not permit programs written for the old XEmacs API to
  21. ;; run on new versions of XEmacs.  Sysdep is a backward-compatibility
  22. ;; package for the latest and greatest XEmacs API.  It permits programmers
  23. ;; to use the latest XEmacs functionality and still have their programs run
  24. ;; on older versions of XEmacs...perhaps even on FSF Emacs.  It should NEVER
  25. ;; ever need to be loaded in the newest XEmacs.  It doesn't even make sense
  26. ;; to put it in the lisp/utils part of the XEmacs distribution because it's
  27. ;; real purpose is to be distributed with packages like w3 which take
  28. ;; advantage of the latest and greatest features of XEmacs but still need to
  29. ;; be run on older versions.  --Stig
  30.  
  31. ;; Any packages that wish to use this file should load it using
  32. ;; `load-library'.  It will not load itself if a version of sysdep.el
  33. ;; that is at least as recent has already been loaded, but will
  34. ;; load over an older version of sysdep.el.  It will attempt to
  35. ;; not redefine functions that have already been custom-redefined,
  36. ;; but will redefine a function if the supplied definition came from
  37. ;; an older version of sysdep.el.
  38.  
  39. ;; Packages such as w3 that wish to include this file with the package
  40. ;; should rename it to something unique, such as `w3-sysdep.el', and
  41. ;; load it with `load-library'.  That will ensure that no conflicts
  42. ;; arise if more than one package in the load path provides a version
  43. ;; of sysdep.el.  If multiple packages load sysdep.el, the most recent
  44. ;; version will end up loaded; as long as I'm careful not to
  45. ;; introduce bugs in previously working definitions, this should work
  46. ;; fine.
  47.  
  48. ;; You may well discover deficiencies in this file as you use it.
  49. ;; The preferable way of dealing with this is to send me a patch
  50. ;; to sysdep.el; that way, the collective body of knowledge gets
  51. ;; increased.
  52.  
  53. ;; DO NOT load this file with `require'.
  54. ;; DO NOT put a `provide' statement in this file.
  55.  
  56. ;; IMPORTANT: leave the version string in the format X.XXX (e.g. 1.001)
  57. ;; so that string comparisons to other versions work properly.
  58.  
  59. (defconst sysdep-potential-version "0.001")
  60.  
  61. (if (and (boundp 'sysdep-version)
  62.      (not (string-lessp sysdep-version sysdep-potential-version)))
  63.     ;; if a more recent version of sysdep was already loaded,
  64.     ;; or if the same package is loaded again, don't load.
  65.     nil
  66.  
  67. (defconst sysdep-version sysdep-potential-version)
  68.  
  69. ;; this macro means: define the function, but only if either it
  70. ;; wasn't bound before, or the supplied binding comes from an older
  71. ;; version of sysdep.el.  That way, user-supplied bindings don't
  72. ;; get overridden.
  73.  
  74. ;; note: sysdep-defalias is often more useful than this function,
  75. ;; esp. since you can do load-time conditionalizing and can
  76. ;; optionally leave the function undefined. (e.g. frame functions
  77. ;; in v18.)
  78.  
  79. (defmacro sysdep-defun (function &rest everything-else)
  80.   (` (cond ((or (not (fboundp (quote (, function))))
  81.         (get (quote (, function)) 'sysdep-defined-this))
  82.         (put (quote (, function)) 'sysdep-defined-this t)
  83.         (defun (, function) (,@ everything-else))))))
  84.  
  85. (defmacro sysdep-defvar (function &rest everything-else)
  86.   (` (cond ((or (not (boundp (quote (, function))))
  87.         (get (quote (, function)) 'sysdep-defined-this))
  88.         (put (quote (, function)) 'sysdep-defined-this t)
  89.         (defvar (, function) (,@ everything-else))))))
  90.  
  91. (defmacro sysdep-defconst (function &rest everything-else)
  92.   (` (cond ((or (not (boundp (quote (, function))))
  93.         (get (quote (, function)) 'sysdep-defined-this))
  94.         (put (quote (, function)) 'sysdep-defined-this t)
  95.         (defconst (, function) (,@ everything-else))))))
  96.  
  97. ;; similar for fset and defalias.  No need to quote as the argument
  98. ;; is already quoted.
  99.  
  100. (defmacro sysdep-fset (function def)
  101.   (` (cond ((and (or (not (fboundp (, function)))
  102.              (get (, function) 'sysdep-defined-this))
  103.          (, def))
  104.         (put (, function) 'sysdep-defined-this t)
  105.         (fset (, function) (, def))))))
  106.  
  107. (defmacro sysdep-defalias (function def)
  108.   (` (cond ((and (or (not (fboundp (, function)))
  109.              (get (, function) 'sysdep-defined-this))
  110.          (, def)
  111.          (or (listp (, def))
  112.              (and (symbolp (, def))
  113.               (fboundp (, def)))))
  114.         (put (, function) 'sysdep-defined-this t)
  115.         (defalias (, function) (, def))))))
  116.  
  117. ;; bootstrapping: defalias and define-function don't exist
  118. ;; in older versions of lemacs
  119.  
  120. (sysdep-fset 'defalias 'fset)
  121. (sysdep-defalias 'define-function 'defalias)
  122.  
  123. ;; useful ways of determining what version is running
  124. ;; emacs-major-version and emacs-minor-version are
  125. ;; already defined in recent versions of FSF Emacs and XEmacs
  126.  
  127. (sysdep-defconst emacs-major-version
  128.          ;; will string-match ever fail?  If so, assume 19.0.
  129.          ;; (should we assume 18.something?)
  130.          (if (string-match "^[0-9]+" emacs-version)
  131.              (string-to-int
  132.               (substring emacs-version
  133.                  (match-beginning 0) (match-end 0)))
  134.            19))
  135.  
  136. (sysdep-defconst emacs-minor-version
  137.          (if (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version)
  138.              (string-to-int
  139.               (substring emacs-version
  140.                  (match-beginning 1) (match-end 1)))
  141.            0))
  142.  
  143. (sysdep-defconst sysdep-running-xemacs
  144.          (or (string-match "Lucid" emacs-version)
  145.              (string-match "XEmacs" emacs-version)))
  146.  
  147. (sysdep-defconst window-system nil)
  148. (sysdep-defconst window-system-version 0)
  149.  
  150. ;; frame-related stuff.
  151.  
  152. (sysdep-defalias 'buffer-dedicated-frame 'buffer-dedicated-screen)
  153. (sysdep-defalias 'deiconify-frame
  154.   (cond ((fboundp 'deiconify-screen) 'deiconify-screen)
  155.     ;; make-frame-visible will be defined as necessary
  156.     (t 'make-frame-visible)))
  157. (sysdep-defalias 'delete-frame 'delete-screen)
  158. (sysdep-defalias 'event-frame 'event-screen)
  159. (sysdep-defalias 'event-glyph-extent 'event-glyph)
  160. (sysdep-defalias 'face-frame 'face-screen)
  161. (sysdep-defalias 'find-file-other-frame 'find-file-other-screen)
  162. (sysdep-defalias 'find-file-read-only-other-frame
  163.   'find-file-read-only-other-screen)
  164. (sysdep-defalias 'frame-height 'screen-height)
  165. (sysdep-defalias 'frame-iconified-p 'screen-iconified-p)
  166. (sysdep-defalias 'frame-left-margin-width 'screen-left-margin-width)
  167. (sysdep-defalias 'frame-list 'screen-list)
  168. (sysdep-defalias 'frame-live-p
  169.   (cond ((fboundp 'screen-live-p) 'screen-live-p)
  170.     ((fboundp 'live-screen-p) 'live-screen-p)
  171.     ;; #### not sure if this is correct (this is for Epoch)
  172.     ;; but gnuserv.el uses it this way
  173.     ((fboundp 'screenp) 'screenp)))
  174. (sysdep-defalias 'frame-name 'screen-name)
  175. (sysdep-defalias 'frame-parameters 'screen-parameters)
  176. (sysdep-defalias 'frame-pixel-height 'screen-pixel-height)
  177. (sysdep-defalias 'frame-pixel-width 'screen-pixel-width)
  178. (sysdep-defalias 'frame-right-margin-width 'screen-right-margin-width)
  179. (sysdep-defalias 'frame-root-window 'screen-root-window)
  180. (sysdep-defalias 'frame-selected-window 'screen-selected-window)
  181. (sysdep-defalias 'frame-totally-visible-p 'screen-totally-visible-p)
  182. (sysdep-defalias 'frame-visible-p 'screen-visible-p)
  183. (sysdep-defalias 'frame-width 'screen-width)
  184. (sysdep-defalias 'framep 'screenp)
  185. (sysdep-defalias 'get-frame-for-buffer 'get-screen-for-buffer)
  186. (sysdep-defalias 'get-frame-for-buffer-noselect 'get-screen-for-buffer-noselect)
  187. (sysdep-defalias 'get-other-frame 'get-other-screen)
  188. (sysdep-defalias 'iconify-frame 'iconify-screen)
  189. (sysdep-defalias 'lower-frame 'lower-screen)
  190. (sysdep-defalias 'mail-other-frame 'mail-other-screen)
  191.  
  192. (sysdep-defalias 'make-frame
  193.   (cond ((fboundp 'make-screen)
  194.      (function (lambda (&optional parameters device)
  195.              (make-screen parameters))))
  196.     ((fboundp 'x-create-screen)
  197.      (function (lambda (&optional parameters device)
  198.              (x-create-screen parameters))))))
  199.  
  200. (sysdep-defalias 'make-frame-invisible 'make-screen-invisible)
  201. (sysdep-defalias 'make-frame-visible
  202.   (cond ((fboundp 'make-screen-visible) 'make-screen-visible)
  203.     ((fboundp 'mapraised-screen) 'mapraised-screen)
  204.     ((fboundp 'x-remap-window)
  205.      (lambda (&optional x)
  206.        (x-remap-window)
  207.        (accept-process-output)))))
  208. (sysdep-defalias 'modify-frame-parameters 'modify-screen-parameters)
  209. (sysdep-defalias 'new-frame 'new-screen)
  210. (sysdep-defalias 'next-frame 'next-screen)
  211. (sysdep-defalias 'next-multiframe-window 'next-multiscreen-window)
  212. (sysdep-defalias 'other-frame 'other-screen)
  213. (sysdep-defalias 'previous-frame 'previous-screen)
  214. (sysdep-defalias 'previous-multiframe-window 'previous-multiscreen-window)
  215. (sysdep-defalias 'raise-frame
  216.   (cond ((fboundp 'raise-screen) 'raise-screen)
  217.     ((fboundp 'mapraise-screen) 'mapraise-screen)))
  218. (sysdep-defalias 'redraw-frame 'redraw-screen)
  219. (sysdep-defalias 'select-frame 'select-screen)
  220. (sysdep-defalias 'selected-frame 'selected-screen)
  221. (sysdep-defalias 'set-buffer-dedicated-frame 'set-buffer-dedicated-screen)
  222. (sysdep-defalias 'set-frame-height 'set-screen-height)
  223. (sysdep-defalias 'set-frame-left-margin-width 'set-screen-left-margin-width)
  224. (sysdep-defalias 'set-frame-position 'set-screen-position)
  225. (sysdep-defalias 'set-frame-right-margin-width 'set-screen-right-margin-width)
  226. (sysdep-defalias 'set-frame-size 'set-screen-size)
  227. (sysdep-defalias 'set-frame-width 'set-screen-width)
  228. (sysdep-defalias 'show-temp-buffer-in-current-frame 'show-temp-buffer-in-current-screen)
  229. (sysdep-defalias 'switch-to-buffer-other-frame 'switch-to-buffer-other-screen)
  230. (sysdep-defalias 'visible-frame-list 'visible-screen-list)
  231. (sysdep-defalias 'window-frame 'window-screen)
  232. (sysdep-defalias 'x-create-frame 'x-create-screen)
  233. (sysdep-defalias 'x-set-frame-icon-pixmap 'x-set-screen-icon-pixmap)
  234. (sysdep-defalias 'x-set-frame-pointer 'x-set-screen-pointer)
  235. (sysdep-defalias 'x-display-color-p 'x-color-display-p)
  236. (sysdep-defalias 'x-display-grayscale-p 'x-grayscale-display-p)
  237. (sysdep-defalias 'menu-event-p 'misc-user-event-p)
  238.  
  239. (sysdep-defun add-submenu (menu-path submenu &optional before)
  240.   "Add a menu to the menubar or one of its submenus.
  241. If the named menu exists already, it is changed.
  242. MENU-PATH identifies the menu under which the new menu should be inserted.
  243.  It is a list of strings; for example, (\"File\") names the top-level \"File\"
  244.  menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
  245.  If MENU-PATH is nil, then the menu will be added to the menubar itself.
  246. SUBMENU is the new menu to add.
  247.  See the documentation of `current-menubar' for the syntax.
  248. BEFORE, if provided, is the name of a menu before which this menu should
  249.  be added, if this menu is not on its parent already.  If the menu is already
  250.  present, it will not be moved."
  251.   (add-menu menu-path (car submenu) (cdr submenu) before))
  252.  
  253. (sysdep-defun add-menu-button (menu-path menu-leaf &optional before)
  254.   "Add a menu item to some menu, creating the menu first if necessary.
  255. If the named item exists already, it is changed.
  256. MENU-PATH identifies the menu under which the new menu item should be inserted.
  257.  It is a list of strings; for example, (\"File\") names the top-level \"File\"
  258.  menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
  259. MENU-LEAF is a menubar leaf node.  See the documentation of `current-menubar'.
  260. BEFORE, if provided, is the name of a menu item before which this item should
  261.  be added, if this item is not on the menu already.  If the item is already
  262.  present, it will not be moved."
  263.  (add-menu-item menu-path (aref menu-leaf 0) (aref menu-leaf 1)
  264.         (aref menu-leaf 2) before))
  265.  
  266. (sysdep-defun make-glyph (&optional spec-list)
  267.   (if (and spec-list (cdr-safe (assq 'x spec-list)))
  268.       (make-pixmap (cdr-safe (assq 'x spec-list)))))
  269.  
  270. (sysdep-defalias 'face-list 'list-faces)
  271.  
  272. ;; Device functions
  273. (sysdep-defalias 'selected-device 'ignore)
  274.  
  275. (sysdep-defun device-baud-rate (&optional device)
  276.   "Return the output baud rate of DEVICE."
  277.   baud-rate)
  278.  
  279. (sysdep-defun device-name (&optional device)
  280.   "Return the name of the specified device."
  281.   ;; doesn't handle the 19.29 multiple X display stuff yet
  282.   ;; doesn't handle NeXTStep either
  283.   (cond
  284.    ((null window-system) "stdio")
  285.    ((getenv "DISPLAY")
  286.     (let ((str (getenv "DISPLAY"))
  287.       (x (1- (length (getenv "DISPLAY"))))
  288.       (y 0))
  289.       (while (/= y x)
  290.     (if (or (= (aref str y) ?:)
  291.         (= (aref str y) ?.))
  292.         (aset str y ?-))
  293.     (setq y (1+ y)))
  294.       str))
  295.    (t "stdio")))
  296.  
  297. (sysdep-defalias 'device-color-cells
  298.   (cond
  299.    ((null window-system) 'ignore)
  300.    ((fboundp 'display-color-cells) 'display-color-cells)
  301.    ((fboundp 'x-display-color-cells) 'x-display-color-cells)
  302.    ((fboundp 'ns-display-color-cells) 'ns-display-color-celles)
  303.    (t 'ignore)))
  304.  
  305. (sysdep-defun try-font-name (fontname)
  306.   (car-safe (x-list-fonts fontname)))
  307.  
  308. (sysdep-defalias 'device-pixel-width
  309.   (cond
  310.    ((and (eq window-system 'x) (fboundp 'x-display-pixel-width))
  311.     'x-display-pixel-width)
  312.    ((and (eq window-system 'ns) (fboundp 'ns-display-pixel-width))
  313.     'ns-display-pixel-width)
  314.    (t 'ignore)))
  315.  
  316. (sysdep-defalias 'device-pixel-height
  317.   (cond
  318.    ((and (eq window-system 'x) (fboundp 'x-display-pixel-height))
  319.     'x-display-pixel-height)
  320.    ((and (eq window-system 'ns) (fboundp 'ns-display-pixel-height))
  321.     'ns-display-pixel-height)
  322.    (t 'ignore)))
  323.  
  324. (sysdep-defalias 'device-mm-width
  325.   (cond
  326.    ((and (eq window-system 'x) (fboundp 'x-display-mm-width))
  327.     'x-display-mm-width)
  328.    ((and (eq window-system 'ns) (fboundp 'ns-display-mm-width))
  329.     'ns-display-mm-width)
  330.    (t 'ignore)))
  331.  
  332. (sysdep-defalias 'device-mm-width
  333.   (cond
  334.    ((and (eq window-system 'x) (fboundp 'x-display-mm-height))
  335.     'x-display-mm-height)
  336.    ((and (eq window-system 'ns) (fboundp 'ns-display-mm-height))
  337.     'ns-display-mm-height)
  338.    (t 'ignore)))
  339.  
  340. (sysdep-defalias 'device-bitplanes
  341.   (cond
  342.    ((and (eq window-system 'x) (fboundp 'x-display-planes))
  343.     'x-display-planes)
  344.    ((and (eq window-system 'ns) (fboundp 'ns-display-planes))
  345.     'ns-display-planes)
  346.    (t 'ignore)))
  347.  
  348. (sysdep-defalias 'device-class
  349.   (cond
  350.    ((and (eq window-system 'x) (fboundp 'x-display-visual-class))
  351.     (function
  352.      (lambda (&optional device)
  353.        (let ((val (symbol-name (x-display-visual-class device))))
  354.      (cond
  355.       ((string-match "color" val) 'color)
  356.       ((string-match "gray-scale" val) 'grayscale)
  357.       (t 'mono))))))
  358.    ((fboundp 'number-of-colors)
  359.     (function
  360.      (lambda (&optional device)
  361.        (if (= 2 (number-of-colors))
  362.        'mono
  363.      'color))))
  364.    ((and (eq window-system 'x) (fboundp 'x-color-p))
  365.     (function
  366.      (lambda (&optional device)
  367.        (if (x-color-p)
  368.        'color
  369.      'mono))))
  370.    ((and (eq window-system 'ns) (fboundp 'ns-display-visual-class))
  371.     (function
  372.      (lambda (&optional device)
  373.        (let ((val (symbol-name (ns-display-visual-class))))
  374.      (cond
  375.       ((string-match "color" val) 'color)
  376.       ((string-match "gray-scale" val) 'grayscale)
  377.       (t 'mono))))))
  378.    (t (function (lambda (&optional device) 'mono)))))
  379.   
  380. (sysdep-defun device-type (&optional device)
  381.   "Return the type of the specified device (e.g. `x' or `tty').
  382. Value is `tty' for a tty device (a character-only terminal),
  383. `x' for a device which is a connection to an X server,
  384. 'ns' for a device which is a connection to a NeXTStep dps server,
  385. 'win32' for a Windows-NT window,
  386. 'pm' for an OS/2 Presentation Manager window,
  387. 'intuition' for an Amiga screen"
  388.   (or window-system 'tty))
  389.  
  390. ;; misc
  391. (sysdep-defun add-hook (hook-var function &optional at-end)
  392.   "Add a function to a hook.
  393. First argument HOOK-VAR (a symbol) is the name of a hook, second
  394.  argument FUNCTION is the function to add.
  395. Third (optional) argument AT-END means to add the function at the end
  396.  of the hook list instead of the beginning.  If the function is already
  397.  present, this has no effect.
  398. Returns nil if FUNCTION was already present in HOOK-VAR, else new
  399.  value of HOOK-VAR."
  400.       (if (not (boundp hook-var)) (set hook-var nil))
  401.       (let ((old (symbol-value hook-var)))
  402.     (if (or (not (listp old)) (eq (car old) 'lambda))
  403.         (setq old (list old)))
  404.     (if (member function old)
  405.         nil
  406.       (set hook-var
  407.            (if at-end
  408.            (append old (list function)) ; don't nconc
  409.          (cons function old))))))
  410.  
  411. (sysdep-defalias 'valid-color-name-p
  412.   (cond
  413.    ((fboundp 'x-valid-color-name-p)    ; XEmacs/Lucid
  414.     'x-valid-color-name-p)
  415.    ((and window-system
  416.      (fboundp 'color-defined-p))    ; NS/Emacs 19
  417.     'color-defined-p)
  418.    ((and window-system
  419.      (fboundp 'x-color-defined-p))    ; Emacs 19
  420.     'x-color-defined-p)
  421.    ((fboundp 'get-color)        ; Epoch
  422.     (function (lambda (color)
  423.         (let ((x (get-color color)))
  424.           (if x
  425.               (setq x (progn
  426.                 (free-color x)
  427.                 t)))
  428.           x))))
  429.    (t 'identity)))            ; All others
  430.  
  431. ;; Misc.
  432. (sysdep-defun split-string (string pattern)
  433.   "Return a list of substrings of STRING which are separated by PATTERN."
  434.   (let (parts (start 0))
  435.     (while (string-match pattern string start)
  436.       (setq parts (cons (substring string start (match-beginning 0)) parts)
  437.         start (match-end 0)))
  438.     (nreverse (cons (substring string start) parts))
  439.     ))
  440.  
  441. (sysdep-defun member (elt list)
  442.   (while (and list (not (equal elt (car list))))
  443.     (setq list (cdr list)))
  444.   list)
  445.  
  446. (sysdep-defun rassoc (key list)
  447.   (let ((found nil))
  448.     (while (and list (not found))
  449.       (if (equal (cdr (car list)) key) (setq found (car list)))
  450.       (setq list (cdr list)))
  451.     found))
  452.  
  453. (sysdep-defun display-error (error-object stream)
  454.   "Display `error-object' on `stream' in a user-friendly way."
  455.   (funcall (or (let ((type (car-safe error-object)))
  456.          (catch 'error
  457.            (and (consp error-object)
  458.             (symbolp type)
  459.             ;;(stringp (get type 'error-message))
  460.             (consp (get type 'error-conditions))
  461.             (let ((tail (cdr error-object)))
  462.               (while (not (null tail))
  463.                 (if (consp tail)
  464.                 (setq tail (cdr tail))
  465.                   (throw 'error nil)))
  466.               t)
  467.             ;; (check-type condition condition)
  468.             (get type 'error-conditions)
  469.             ;; Search class hierarchy
  470.             (let ((tail (get type 'error-conditions)))
  471.               (while (not (null tail))
  472.                 (cond ((not (and (consp tail)
  473.                          (symbolp (car tail))))
  474.                    (throw 'error nil))
  475.                   ((get (car tail) 'display-error)
  476.                    (throw 'error (get (car tail)
  477.                               'display-error)))
  478.                   (t
  479.                    (setq tail (cdr tail)))))
  480.               ;; Default method
  481.               (function
  482.                (lambda (error-object stream)
  483.                  (let ((type (car error-object))
  484.                    (tail (cdr error-object))
  485.                    (first t))
  486.                    (if (eq type 'error)
  487.                    (progn (princ (car tail) stream)
  488.                       (setq tail (cdr tail)))
  489.                  (princ (or (get type 'error-message) type)
  490.                     stream))
  491.                    (while tail
  492.                  (princ (if first ": " ", ") stream)
  493.                  (prin1 (car tail) stream)
  494.                  (setq tail (cdr tail)
  495.                        first nil)))))))))
  496.            (function
  497.         (lambda (error-object stream)
  498.           (princ "Peculiar error " stream)
  499.           (prin1 error-object stream))))
  500.        error-object stream))
  501.  
  502. ;; window functions
  503.  
  504. ;; not defined in v18
  505. (sysdep-defun eval-buffer (bufname &optional printflag)
  506.   (save-excursion
  507.     (set-buffer bufname)
  508.     (eval-current-buffer)))
  509.  
  510. (sysdep-defun window-minibuffer-p (window)
  511.   "Returns non-nil if WINDOW is a minibuffer window."
  512.   (eq window (minibuffer-window)))
  513.  
  514. ;; not defined in v18
  515. (sysdep-defun window-live-p (window)
  516.   "Returns t if OBJ is a window which is currently visible."
  517.   (and (windowp window)
  518.        (window-point window)))
  519.  
  520. ;; this parenthesis closes the if statement at the top of the file.
  521.  
  522. )
  523.  
  524. ;; DO NOT put a provide statement here.  This file should never be
  525. ;; loaded with `require'.  Use `load-library' instead.
  526.  
  527. ;;; sysdep.el ends here
  528.  
  529. ;;;(sysdep.el) Local Variables:
  530. ;;;(sysdep.el) eval: (put 'sysdep-defun 'lisp-indent-function 'defun)
  531. ;;;(sysdep.el) eval: (put 'sysdep-defalias 'lisp-indent-function 'defun)
  532. ;;;(sysdep.el) eval: (put 'sysdep-defconst 'lisp-indent-function 'defun)
  533. ;;;(sysdep.el) eval: (put 'sysdep-defvar 'lisp-indent-function 'defun)
  534. ;;;(sysdep.el) End:
  535.